perm filename READ1.F4[MU5,LCS] blob
sn#108373 filedate 1974-06-21 generic text, type T, neo UTF8
CREAD1 INTERPRETATIVE READING ROUTINE
C****MUSIC V****
SUBROUTINEREAD1
COMMON P(100),IP(10),D(2000),IPDP
C***** PDP ***** IPDP WAS ADDED TO COMMON LIST IN PLACE OF ENTRY FEATURE.
DIMENSION CARD(129),ICAR(128),IBCD(300),LOP(3,30)
DIMENSIONBCD(300)
DIMENSIONIBC(12),IVT(4)
EQUIVALENCE(CARD,ICAR)
EQUIVALENCE(BCD,IBCD)
DATANOPS,NBC,NC/26,3,72/
DATA IDEC,ISTAR/'.','*'/
CCC DATA IBC(1),IBC(2),IBC(3),IBC(4)/'=',' ',',','-'/
DATA IBC(1),IBC(2),IBC(3),IBC(4)/';',' ',',','-'/
C********* NO!!!!! THE CHARACTER = HAS BEEN SUBSTITUTED FOR
C THE SEMICOLON AS THE END OF STATEMENT DELIMITER
DATA IVT/'P','F','B','V'/
DATA LOP/'N','O','T','I','N','S','G','E','N','S','V','3',
1 'S','E','C','T','E','R','S','V','1','S','V','2','P','L','F',
2 'P','L','S','S','I','3','S','I','A','C','O','M','E','N','D',
3 'O','U','T','O','S','C','A','D','2','R','A','N','E','N','V',
4 'S','T','R','A','D','3','A','D','4','M','L','T','F','L','T',
5 'R','A','H','S','E','T',0,0,0,0,0,0,0,0,0,0,0,0/
C******* LAST 12 LOCATIONS NOT YET USED. **** PDP *******
EQUIVALENCE (JSEMI,IBC(1)),(JBLANK,IBC(2))
C TO SCAN INPUT DATA TO #, ORGANIZE FIELDS AND PRINT
IF(IPDP.EQ.0)GO TO 99
C********** PDP **************
IF(END+SNA8-1.)10,10,90
10 IBK=2
END=0.
ERR=0.
NUMU=0
ISEMI=1
L=3
J=0
11 I=I+1
IF(I.GT.NC)GO TO 15
IF(J.EQ.299)GO TO 21
DO 13N=1,NBC
IF(ICAR(I)-IBC(N))13,12,13
12 GO TO (20,16,18),N
C ; BLA ,
13 CONTINUE
J=J+1
IBCD(J)=ICAR(I)
IBK=1
GO TO 11
14 IBK=N
GO TO 11
CC 15 READ (5,1,ERR=95,END=95) (CARD(I),I=1,NC)
C******** PDP ********
15 READ (1,1,ERR=95,END=95) I, (CARD(I),I=1,NC)
C***** PDP ***** FIRST 'I' IS FOR PDP LINE NUMBERS!
1 FORMAT(I,128A1)
CC 1 FORMAT(128A1)
PRINT 2,(CARD(I),I=1,NC)
2 FORMAT(1H 128A1)
I=0
GO TO 11
16 GO TO (17,11,11),IBK
17 IBK=N
J=J+1
IBCD(J)=JBLANK
GO TO (11,21),ISEMI
18 GO TO (17,14,19),IBK
19 J=J+1
IBCD(J)=0
GO TO 17
20 ISEMI=2
GO TO (17,21,19),IBK
21 J=J+1
IBCD(J)=JSEMI
C TO SCAN FOR OP CODE
DO 24N=1,NOPS
M=N
DO 23K=1,3
IF (IBCD(K)-LOP(K,N)) 24,23,24
23 CONTINUE
GO TO 26
24 CONTINUE
GO TO 40
26 NP=1
27 L=L+1
IF(IBCD(L)-JBLANK)27,29,27
29 GO TO (100,200,300,400,500,600,700,800,900,1000,1100,1200,1300,
1217,201,202,203,204,205,206,207,208,209,210,211,212),M
C OP CODE 1 TO PLAY NOTE
100 P(1)=1.
GO TO 30
C OP CODE 2 TO DEFINE INSTRUMENT
200 P(1)=2.
IDEF=1
N1=1
GO TO 70
2000 P(2)=XN
N1=2
GO TO 70
2001 P(3)=XN
IP(1)=3
GO TO 50
C OUT BOX
201 P(3)=101.
NPW=2
IF(STER)220,220,2011
2011 SNA8=1.
STER=0.
GO TO 220
C OSCILLATOR
202 P(3)=102.
NPW=5
GO TO 220
C ADD 2
203 P(3)=103.
NPW=3
GO TO 220
C RANDOM AND INTERPOLATE
204 P(3)=104.
NPW=6
GO TO 220
C LINEAR ENVELOPE GENERATOR
205 P(3)=105.
NPW=7
GO TO 220
C STEREO OUT BOX
206 P(3)=106.
NPW=3
IF(STER)220,2061,220
2061 SNA8=1.
STER=1.
GO TO 220
C THREE INPUT ADDER
207 P(3)=107.
NPW=4
GO TO 220
C FOUR INPUT ADDER
208 P(3)=108.
NPW=5
GO TO 220
C MULTIPLIER
209 P(3)=109.
NPW=3
GO TO 220
C FILTER
210 P(3)=112.
NPW=4
GO TO 220
C RANDOM AND HOLD
211 P(3)=111.
NPW=5
GO TO 220
C SET NEW FUNCTION
212 P(3)=110.
NPW=1
GO TO 220
C END OF INSTRUMENT
217 IP(1)=2
IDEF=0
END=1.
GO TO 50
C UNNAMED UNIT - NUMERICAL NAME ASSUMED
218 N1=8
NUMU=1
L=0
GO TO 70
219 M=XN+14.
IF(XN.LT.11.)GO TO 29
P(3)=XN
C TO INTERPRET VARS IN UNIT DEFS
220 NP=3
221 IF(IBCD(L+1)-JSEMI)222,240,222
222 NP=NP+1
L=L+1
DO 223N=1,4
IF(IBCD(L)-IVT(N))223,225,223
223 CONTINUE
224 L=L+1
IF(IBCD(L).EQ.JBLANK)GO TO 46
GO TO 224
225 GO TO (231,232,233,234),N
C P TYPE
231 N1=3
GO TO 70
2311 P(NP)=XN
GO TO 221
C F TYPE
232 N1=4
GO TO 70
2321 P(NP)=-(XN+100.)
GO TO 221
C B TYPE
233 N1=5
GO TO 70
2331 P(NP)=-XN
GO TO 221
C V TYPE
234 N1=6
GO TO 70
2341 P(NP)=XN+100.
GO TO 221
240 IF(NUMU.EQ.1)GO TO 242
241 IF(NPW+3-NP)42,242,42
242 IP(1)=NP
GO TO 50
C OP CODE 3 - TO GENERATE FUNCTION
300 P(1)=3.
GO TO 30
C OP CODE 4 - TO SET PARAM 3RD PASS
400 P(1)=4.
GO TO 30
C OP CODE 5 TO END SEC
500 P(1)=5.
GO TO 30
C OP CODE 6 TO TERMINATE PIECE
600 P(1)=6.
GO TO 30
C OP CODE 7 TO SET PARAM 1ST PASS
700 P(1)=7.
GO TO 30
C OP CODE 8 TO SET PARAM 2ND PASS
800 P(1)=8.
GO TO 30
C OP CODE 9 TO EXECUTE SUB 1ST PASS
900 P(1)=9.
GO TO 30
C OP CODE 10 TO EXECUTE SUB 2ND PASS
1000 P(1)=10.
GO TO 30
C OP CODE 11 TO SET INTEGER 3RD PASS
1100 P(1)=11.
GO TO 30
C OP CODE 12 TO SET INTEGER ALL PASSES
1200 P(1)=12.
GO TO 30
C OP CODE 13 FOR COMMENTS
1300 IF(IBCD(L)-JSEMI)1301,10,1301
1301 L=L+1
GO TO 1300
C TO STORE PFIELDS
30 IF(IDEF)32,32,43
32 IF(IBCD(L+1)-JSEMI)33,34,33
33 NP=NP+1
N1=7
GO TO 70
331 P(NP)=XN
GO TO 32
34 IP(1)=NP
IF(NP-1)47,47,50
C ERRORS
40 IF(IDEF)41,41,218
41 L=L+1
IF(IBCD(L).NE.JSEMI)GO TO 41
PRINT 3
3 FORMAT(26H OP CODE NOT UNDERSTOOD)
GO TO 49
42 PRINT 4
4 FORMAT(44H UNIT CONTAINS WRONG NUMBER OF PARAMETERS)
GO TO 49
43 PRINT 5
5 FORMAT(36H INSTRUMENT DEFINITION INCOMPLETE)
ERR=1.
IDEF=0
GO TO 32
44 PRINT 6
6 FORMAT(25H ERROR IN NUMERIC DATA)
ERR=1.
IF(NUMU.EQ.1)GO TO 45
GO TO 30
45 PRINT 7
7 FORMAT(46H+ FOR UNIT DESIGNATION)
P(3)=0.
GO TO 220
46 PRINT 8
8 FORMAT(40H IMPROPER VARIABLE IN UNIT DEFINITION)
ERR=1.
GO TO 221
47 PRINT 9
9 FORMAT(24H STATEMENT INCOMPLETE)
49 IP(2)=1
GO TO 10
50 IF(ERR.EQ.1.)GO TO 49
RETURN
C CONVERSION OF NUMERIC FIELD TO FLOATING POINT
70 SGN=1.
IF(IBCD(L+1).NE.IBC(4))GO TO 79
SGN=-1.
L=L+1
79 L1=L+1
LD=L1
XN=0.
71 L=L+1
C *** I DON'T UNDERSTAND THIS PART OF THE SCANNER!
CC IF(IBCD(L).EQ.JBLANK)GO TO 77
IF(IBCD(L)-JBLANK)72,77,72
C THIS LOOKS FOR #S, LETTERS, BLANKS, DECI.PTS, & *S. OTHERWISE=ERROR!?
C******** PDP ********
72 IF(IBCD(L).LT.10)GO TO 71
IF(IBCD(L)-IDEC)74,71,74
74 IF(IBCD(L)-ISTAR)76,71,76
76 GO TO 71
C ERROR CHECK IS REMOVED!
CC**NEXT 2 LINES BY-PASSED*** 76 L=L+1
IF(IBCD(L).EQ.JBLANK)GO TO 44
GO TO 76
77 IF(IBCD(L1)-ISTAR)80,78,80
78 XN=P(NP)
GO TO 89
80 DO 81LL=L1,L
LD=LL
IF(IBCD(LL)-IDEC)81,82,81
81 CONTINUE
82 IEX=0
LA=L1
LB=LD-1
IF(LD-L1)86,86,83
83 IEX=LD-LA
84 CALL MOVR (IBCD,LA,LB)
DO 85 LL=LA,LB
IEX=IEX-1
XI=IBCD(LL)
85 XN=XN+XI*10.**IEX
86 IF(L-LB-2)88,88,87
87 LA=LD+1
LB=L-1
GO TO 84
88 XN=XN*SGN
89 GO TO (2000,2001,2311,2321,2331,2341,331,219),N1
C TO WRITE SIA 8 FOR MONO STEREO CONTROL
90 P(1)=12.
P(3)=8.
P(4)=STER
IP(1)=4
END=0.
SNA8=0.
GO TO 50
C FOR PREMATURE END OF FILE ON INPUT
95 NP=2
IP(2)=1
L=0
IBCD(1)=JSEMI
GO TO 600
C TO INITIALIZE
CC ENTRYREAD0
CC READ (5,1,ERR=95,END=95) (CARD(I),I=1,NC)
C******** PDP ********
99 READ (1,1,ERR=95,END=95) I,(CARD(I),I=1,NC)
C***** PDP ***** FIRST 'I' IS FOR PDP LINE NUMBERS!
CC WRITE (6,2) (CARD(I),I=1,NC)
PRINT 2,(CARD(I),I=1,NC)
C******** PDP *******
IPDP=1
I=0
IDEF=0
IBK=2
STER=0.
END=0.
SNA8=0.
RETURN
END